home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / perl5 / Benchmark.pm < prev    next >
Encoding:
Perl POD Document  |  1995-07-03  |  6.4 KB  |  246 lines
  1. package Benchmark;
  2.  
  3. # Purpose: benchmark running times of code.
  4. #
  5. #
  6. # Usage - to time code snippets and print results:
  7. #
  8. #    timethis($count, '...code...');
  9. #        
  10. # prints:
  11. #    timethis 100:  2 secs ( 0.23 usr  0.10 sys =  0.33 cpu)
  12. #
  13. #
  14. #    timethese($count, {
  15. #        Name1 => '...code1...',
  16. #        Name2 => '...code2...',
  17. #        ... });
  18. # prints:
  19. #    Benchmark: timing 100 iterations of Name1, Name2...
  20. #         Name1:  2 secs ( 0.50 usr  0.00 sys =  0.50 cpu)
  21. #         Name2:  1 secs ( 0.48 usr  0.00 sys =  0.48 cpu)
  22. #
  23. # The default display style will automatically add child process
  24. # values if non-zero.
  25. #
  26. #
  27. # Usage - to time sections of your own code:
  28. #
  29. #    use Benchmark;
  30. #    $t0 = new Benchmark;
  31. #    ... your code here ...
  32. #    $t1 = new Benchmark;
  33. #    $td = &timediff($t1, $t0);
  34. #    print "the code took:",timestr($td),"\n";
  35. #
  36. #    $t = &timeit($count, '...other code...')
  37. #    print "$count loops of other code took:",timestr($t),"\n";
  38. # 
  39. #
  40. # Data format:
  41. #       The data is stored as a list of values from the time and times
  42. #       functions: ($real, $user, $system, $children_user, $children_system)
  43. #    in seconds for the whole loop (not divided by the number of rounds).
  44. #        
  45. # Internals:
  46. #    The timing is done using time(3) and times(3).
  47. #        
  48. #    Code is executed in the callers package
  49. #
  50. #    Enable debugging by:  $Benchmark::debug = 1;
  51. #
  52. #    The time of the null loop (a loop with the same
  53. #    number of rounds but empty loop body) is substracted
  54. #    from the time of the real loop.
  55. #
  56. #    The null loop times are cached, the key being the
  57. #    number of rounds. The caching can be controlled using
  58. #    &clearcache($key); &clearallcache;
  59. #    &disablecache; &enablecache;
  60. #
  61. # Caveats:
  62. #
  63. #    The real time timing is done using time(2) and
  64. #    the granularity is therefore only one second.
  65. #
  66. #    Short tests may produce negative figures because perl
  67. #    can appear to take longer to execute the empty loop 
  68. #    than a short test: try timethis(100,'1');
  69. #
  70. #    The system time of the null loop might be slightly
  71. #    more than the system time of the loop with the actual
  72. #    code and therefore the difference might end up being < 0
  73. #
  74. #    More documentation is needed :-(
  75. #    Especially for styles and formats.
  76. #
  77. # Authors:    Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
  78. #         Tim Bunce <Tim.Bunce@ig.co.uk>
  79. #
  80. #
  81. # Last updated:    Sept 8th 94 by Tim Bunce
  82. #
  83.  
  84. use Exporter;
  85. @ISA=(Exporter);
  86. @EXPORT=qw(timeit timethis timethese timediff timestr);
  87. @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
  88.  
  89. &init;
  90.  
  91. sub init {
  92.     $debug = 0;
  93.     $min_count = 4;
  94.     $min_cpu   = 0.4;
  95.     $defaultfmt = '5.2f';
  96.     $defaultstyle = 'auto';
  97.     # The cache can cause a slight loss of sys time accuracy. If a
  98.     # user does many tests (>10) with *very* large counts (>10000)
  99.     # or works on a very slow machine the cache may be useful.
  100.     &disablecache;
  101.     &clearallcache;
  102. }
  103.  
  104. sub clearcache    { delete $cache{$_[0]}; }
  105. sub clearallcache { %cache = (); }
  106. sub enablecache   { $cache = 1; }
  107. sub disablecache  { $cache = 0; }
  108.  
  109.  
  110. # --- Functions to process the 'time' data type
  111.  
  112. sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; }
  113.  
  114. sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
  115. sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
  116. sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
  117. sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
  118.  
  119. sub timediff{
  120.     my($a, $b) = @_;
  121.     my(@r);
  122.     for($i=0; $i < @$a; ++$i){
  123.     push(@r, $a->[$i] - $b->[$i]);
  124.     }
  125.     bless \@r;
  126. }
  127.  
  128. sub timestr{
  129.     my($tr, $style, $f) = @_;
  130.     my(@t) = @$tr;
  131.     warn "bad time value" unless @t==5;
  132.     my($r, $pu, $ps, $cu, $cs) = @t;
  133.     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
  134.     $f = $defaultfmt unless $f;
  135.     # format a time in the required style, other formats may be added here
  136.     $style = $defaultstyle unless $style;
  137.     $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/;
  138.     my($s) = "@t $style"; # default for unknown style
  139.     $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
  140.                 @t,$t) if $style =~ /^all$/;
  141.     $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
  142.                 $r,$pu,$ps,$pt) if $style =~ /^noc$/;
  143.     $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
  144.                 $r,$cu,$cs,$ct) if $style =~ /^nop$/;
  145.     $s;
  146. }
  147. sub timedebug{
  148.     my($msg, $t) = @_;
  149.     print STDERR "$msg",timestr($t),"\n" if ($debug);
  150. }
  151.  
  152.  
  153. # --- Functions implementing low-level support for timing loops
  154.  
  155. sub runloop {
  156.     my($n, $c) = @_;
  157.     my($t0, $t1, $td); # before, after, difference
  158.  
  159.     # find package of caller so we can execute code there
  160.     my ($curpack) = caller(0);
  161.     my ($i, $pack)= 0;
  162.     while (($pack) = caller(++$i)) {
  163.     last if $pack ne $curpack;
  164.     }
  165.  
  166.     my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
  167.     my $subref  = eval $subcode;
  168.     die "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
  169.     print STDERR "runloop $n '$subcode'\n" if ($debug);
  170.  
  171.     $t0 = &new;
  172.     &$subref;
  173.     $t1 = &new;
  174.     $td = &timediff($t1, $t0);
  175.  
  176.     timedebug("runloop:",$td);
  177.     $td;
  178. }
  179.  
  180.  
  181. sub timeit {
  182.     my($n, $code) = @_;
  183.     my($wn, $wc, $wd);
  184.  
  185.     printf STDERR "timeit $n $code\n" if $debug;
  186.  
  187.     if ($cache && exists $cache{$n}){
  188.     $wn = $cache{$n};
  189.     }else{
  190.     $wn = &runloop($n, '');
  191.     $cache{$n} = $wn;
  192.     }
  193.  
  194.     $wc = &runloop($n, $code);
  195.  
  196.     $wd = timediff($wc, $wn);
  197.  
  198.     timedebug("timeit: ",$wc);
  199.     timedebug("      - ",$wn);
  200.     timedebug("      = ",$wd);
  201.  
  202.     $wd;
  203. }
  204.  
  205.  
  206. # --- Functions implementing high-level time-then-print utilities
  207.  
  208. sub timethis{
  209.     my($n, $code, $title, $style) = @_;
  210.     my($t) = timeit($n, $code);
  211.     local($|) = 1;
  212.     $title = "timethis $n" unless $title;
  213.     $style = "" unless $style;
  214.     printf("%10s: ", $title);
  215.     print timestr($t, $style),"\n";
  216.     # A conservative warning to spot very silly tests.
  217.     # Don't assume that your benchmark is ok simply because
  218.     # you don't get this warning!
  219.     print "            (warning: too few iterations for a reliable count)\n"
  220.     if (   $n < $min_count
  221.         || ($t->real < 1 && $n < 1000)
  222.         || $t->cpu_a < $min_cpu);
  223.     $t;
  224. }
  225.  
  226.  
  227. sub timethese{
  228.     my($n, $alt, $style) = @_;
  229.     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
  230.         unless ref $alt eq HASH;
  231.     my(@all);
  232.     my(@names) = sort keys %$alt;
  233.     $style = "" unless $style;
  234.     print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
  235.     foreach(@names){
  236.     $t = timethis($n, $alt->{$_}, $_, $style);
  237.     push(@all, $t);
  238.     }
  239.     # we could produce a summary from @all here
  240.     # sum, min, max, avg etc etc
  241.     @all;
  242. }
  243.  
  244.  
  245. 1;
  246.